home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / f2c_5_92 Folder / f2c_5_92 / libI77 / rdfmt.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-05-26  |  5.6 KB  |  326 lines  |  [TEXT/ttxt]
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. #include "fp.h"
  5.  
  6. extern int cursor;
  7. rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
  8. {    int ch;
  9.     for(;cursor>0;cursor--) if((ch=(*getn)())<0) return(ch);
  10.     if(cursor<0)
  11.     {    if(recpos+cursor < 0) /*err(elist->cierr,110,"fmt")*/
  12.             cursor = -recpos;    /* is this in the standard? */
  13.         if(external == 0) {
  14.             extern char *icptr;
  15.             icptr += cursor;
  16.         }
  17.         else if(curunit && curunit->useek)
  18.             (void) fseek(cf,(long) cursor,SEEK_CUR);
  19.         else
  20.             err(elist->cierr,106,"fmt");
  21.         recpos += cursor;
  22.         cursor=0;
  23.     }
  24.     switch(p->op)
  25.     {
  26.     default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op);
  27.         sig_die(fmtbuf, 1);
  28.     case I: ch = (rd_I((Uint *)ptr,p->p1,len, 10));
  29.         break;
  30.     case IM: ch = (rd_I((Uint *)ptr,p->p1,len, 10));
  31.         break;
  32.     case O: ch = (rd_I((Uint *)ptr, p->p1, len, 8));
  33.         break;
  34.     case L: ch = (rd_L((ftnint *)ptr,p->p1));
  35.         break;
  36.     case A:    ch = (rd_A(ptr,len));
  37.         break;
  38.     case AW:
  39.         ch = (rd_AW(ptr,p->p1,len));
  40.         break;
  41.     case E: case EE:
  42.     case D:
  43.     case G:
  44.     case GE:
  45.     case F:    ch = (rd_F((ufloat *)ptr,p->p1,p->p2,len));
  46.         break;
  47.     }
  48.     if(ch == 0) return(ch);
  49.     else if(ch == EOF) return(EOF);
  50.     if (cf)
  51.         clearerr(cf);
  52.     return(errno);
  53. }
  54. rd_ned(p) struct syl *p;
  55. {
  56.     switch(p->op)
  57.     {
  58.     default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op);
  59.         sig_die(fmtbuf, 1);
  60.     case APOS:
  61.         return(rd_POS(*(char **)&p->p2));
  62.     case H:    return(rd_H(p->p1,*(char **)&p->p2));
  63.     case SLASH: return((*donewrec)());
  64.     case TR:
  65.     case X:    cursor += p->p1;
  66.         return(1);
  67.     case T: cursor=p->p1-recpos - 1;
  68.         return(1);
  69.     case TL: cursor -= p->p1;
  70.         if(cursor < -recpos)    /* TL1000, 1X */
  71.             cursor = -recpos;
  72.         return(1);
  73.     }
  74. }
  75. rd_I(n,w,len, base) ftnlen len; Uint *n; register int base;
  76. {    long x;
  77.     int sign,ch;
  78.     char s[84], *ps;
  79.     ps=s; x=0;
  80.     while (w)
  81.     {
  82.         GET(ch);
  83.         if (ch==',' || ch=='\n') break;
  84.         *ps=ch; ps++; w--;
  85.     }
  86.     *ps='\0';
  87.     ps=s;
  88.     while (*ps==' ') ps++;
  89.     if (*ps=='-') { sign=1; ps++; }
  90.     else { sign=0; if (*ps=='+') ps++; }
  91. loop:    while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; }
  92.     if (*ps==' ') {if (cblank) x *= base; ps++; goto loop;}
  93.     if(sign) x = -x;
  94.     if(len==sizeof(integer)) n->il=x;
  95.     else if(len == sizeof(char)) n->ic = x;
  96.     else n->is=x;
  97.     if (*ps) return(errno=115); else return(0);
  98. }
  99. rd_L(n,w) ftnint *n;
  100. {    int ch;
  101.     char s[84], *ps;
  102.     ps=s;
  103.     while (w) {
  104.         GET(ch);
  105.         if (ch==','||ch=='\n') break;
  106.         *ps=ch;
  107.         ps++; w--;
  108.         }
  109.     *ps='\0';
  110.     ps=s; while (*ps==' ') ps++;
  111.     if (*ps=='.') ps++;
  112.     if (*ps=='t' || *ps == 'T') { *n=1; return(0); }
  113.     else if (*ps == 'f' || *ps == 'F') { *n=0; return(0); }
  114.     else return(errno=116);
  115. }
  116.  
  117. #include "ctype.h"
  118.  
  119. rd_F(p, w, d, len)
  120. ftnlen len;
  121. ufloat *p;
  122. {
  123.     char s[FMAX+EXPMAXDIGS+4];
  124.     register int ch;
  125.     register char *sp, *spe, *sp1;
  126.     double atof(), x;
  127.     int scale1, se;
  128.     long e, exp;
  129.  
  130.     sp1 = sp = s;
  131.     spe = sp + FMAX;
  132.     exp = -d;
  133.     x = 0.;
  134.  
  135.     do {
  136.         GET(ch);
  137.         w--;
  138.         } while (ch == ' ' && w);
  139.     switch(ch) {
  140.         case '-': *sp++ = ch; sp1++; spe++;
  141.         case '+':
  142.             if (!w) goto zero;
  143.             --w;
  144.             GET(ch);
  145.         }
  146.     while(ch == ' ') {
  147. blankdrop:
  148.         if (!w--) goto zero; GET(ch); }
  149.     while(ch == '0')
  150.         { if (!w--) goto zero; GET(ch); }
  151.     if (ch == ' ' && cblank)
  152.         goto blankdrop;
  153.     scale1 = scale;
  154.     while(isdigit(ch)) {
  155. digloop1:
  156.         if (sp < spe) *sp++ = ch;
  157.         else ++exp;
  158. digloop1e:
  159.         if (!w--) goto done;
  160.         GET(ch);
  161.         }
  162.     if (ch == ' ') {
  163.         if (cblank)
  164.             { ch = '0'; goto digloop1; }
  165.         goto digloop1e;
  166.         }
  167.     if (ch == '.') {
  168.         exp += d;
  169.         if (!w--) goto done;
  170.         GET(ch);
  171.         if (sp == sp1) { /* no digits yet */
  172.             while(ch == '0') {
  173. skip01:
  174.                 --exp;
  175. skip0:
  176.                 if (!w--) goto done;
  177.                 GET(ch);
  178.                 }
  179.             if (ch == ' ') {
  180.                 if (cblank) goto skip01;
  181.                 goto skip0;
  182.                 }
  183.             }
  184.         while(isdigit(ch)) {
  185. digloop2:
  186.             if (sp < spe)
  187.                 { *sp++ = ch; --exp; }
  188. digloop2e:
  189.             if (!w--) goto done;
  190.             GET(ch);
  191.             }
  192.         if (ch == ' ') {
  193.             if (cblank)
  194.                 { ch = '0'; goto digloop2; }
  195.             goto digloop2e;
  196.             }
  197.         }
  198.     switch(ch) {
  199.       default:
  200.         break;
  201.       case '-': se = 1; goto signonly;
  202.       case '+': se = 0; goto signonly;
  203.       case 'e':
  204.       case 'E':
  205.       case 'd':
  206.       case 'D':
  207.         if (!w--)
  208.             goto bad;
  209.         GET(ch);
  210.         while(ch == ' ') {
  211.             if (!w--)
  212.                 goto bad;
  213.             GET(ch);
  214.             }
  215.         se = 0;
  216.           switch(ch) {
  217.           case '-': se = 1;
  218.           case '+':
  219. signonly:
  220.             if (!w--)
  221.                 goto bad;
  222.             GET(ch);
  223.             }
  224.         while(ch == ' ') {
  225.             if (!w--)
  226.                 goto bad;
  227.             GET(ch);
  228.             }
  229.         if (!isdigit(ch))
  230.             goto bad;
  231.  
  232.         e = ch - '0';
  233.         for(;;) {
  234.             if (!w--)
  235.                 { ch = '\n'; break; }
  236.             GET(ch);
  237.             if (!isdigit(ch)) {
  238.                 if (ch == ' ') {
  239.                     if (cblank)
  240.                         ch = '0';
  241.                     else continue;
  242.                     }
  243.                 else
  244.                     break;
  245.                 }
  246.             e = 10*e + ch - '0';
  247.             if (e > EXPMAX && sp > sp1)
  248.                 goto bad;
  249.             }
  250.         if (se)
  251.             exp -= e;
  252.         else
  253.             exp += e;
  254.         scale1 = 0;
  255.         }
  256.     switch(ch) {
  257.       case '\n':
  258.       case ',':
  259.         break;
  260.       default:
  261. bad:
  262.         return (errno = 115);
  263.         }
  264. done:
  265.     if (sp > sp1) {
  266.         while(*--sp == '0')
  267.             ++exp;
  268.         if (exp -= scale1)
  269.             sprintf(sp+1, "e%ld", exp);
  270.         else
  271.             sp[1] = 0;
  272.         x = atof(s);
  273.         }
  274. zero:
  275.     if (len == sizeof(real))
  276.         p->pf = x;
  277.     else
  278.         p->pd = x;
  279.     return(0);
  280.     }
  281.  
  282.  
  283. rd_A(p,len) char *p; ftnlen len;
  284. {    int i,ch;
  285.     for(i=0;i<len;i++)
  286.     {    GET(ch);
  287.         *p++=VAL(ch);
  288.     }
  289.     return(0);
  290. }
  291. rd_AW(p,w,len) char *p; ftnlen len;
  292. {    int i,ch;
  293.     if(w>=len)
  294.     {    for(i=0;i<w-len;i++)
  295.             GET(ch);
  296.         for(i=0;i<len;i++)
  297.         {    GET(ch);
  298.             *p++=VAL(ch);
  299.         }
  300.         return(0);
  301.     }
  302.     for(i=0;i<w;i++)
  303.     {    GET(ch);
  304.         *p++=VAL(ch);
  305.     }
  306.     for(i=0;i<len-w;i++) *p++=' ';
  307.     return(0);
  308. }
  309. rd_H(n,s) char *s;
  310. {    int i,ch;
  311.     for(i=0;i<n;i++)
  312.         if((ch=(*getn)())<0) return(ch);
  313.         else *s++ = ch=='\n'?' ':ch;
  314.     return(1);
  315. }
  316. rd_POS(s) char *s;
  317. {    char quote;
  318.     int ch;
  319.     quote= *s++;
  320.     for(;*s;s++)
  321.         if(*s==quote && *(s+1)!=quote) break;
  322.         else if((ch=(*getn)())<0) return(ch);
  323.         else *s = ch=='\n'?' ':ch;
  324.     return(1);
  325. }
  326.